home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 1 of 2).iso / utilities / u288.dms / in.adf / Examples / Counter.p < prev    next >
Encoding:
Text File  |  1990-07-18  |  3.2 KB  |  158 lines
  1. Program Counter;
  2.  
  3. {
  4. This program reads a text file, then prints a report telling
  5. you all the words in the file, and how many times each was
  6. used.  It was intended as a demonstration and test of string
  7. stuff and some addressing things.  The other major reason I
  8. wrote it is because I am currently re-writing the compiler's
  9. symbol table stuff, and the two designs I'm thinking about are
  10. binary trees and hash tables.  I am going to use the hash
  11. tables, but I wanted to get familiar with both methods before
  12. I started the actual work.
  13. }
  14.  
  15. {$I "Include:Utils/Parameters.i"}
  16. {$I "Include:Utils/StringLib.i"}
  17.  
  18. type
  19.     WordRec = Record
  20.     Left,
  21.     Right : ^WordRec;
  22.     Count : Integer;
  23.     Data  : array [0..255] of char;
  24.     end;
  25.     WordPtr = ^WordRec;
  26.  
  27. var
  28.    Root        : WordPtr;
  29.    CurrentChar    : Char;
  30.    InFile    : Text;
  31.    CurrentWord    : String;
  32.    TotalWords    : Integer;
  33.  
  34. Procedure ReadChar;
  35. begin
  36.     if eof(InFile) then
  37.     CurrentChar := Chr(0)
  38.     else
  39.     Read(Infile, CurrentChar);
  40. end;
  41.  
  42. Procedure SkipWhiteSpace;
  43. begin
  44.     while (not eof(Infile)) and (not isalpha(CurrentChar)) do
  45.     ReadChar;
  46. end;
  47.  
  48. Procedure ReadWord;
  49. var
  50.    i : Integer;
  51. begin
  52.     i := 0;
  53.     while isalnum(CurrentChar) do begin
  54.     CurrentWord[i] := CurrentChar;
  55.     i := Succ(i);
  56.     ReadChar;
  57.     end;
  58.     CurrentWord[i] := Chr(0);
  59. end;
  60.  
  61. Procedure EnterWord(rec : WordPtr);
  62. var
  63.     Current : WordPtr;
  64. begin
  65.     if Root = nil then begin
  66.     Root := rec;
  67.     return;
  68.     end;
  69.     Current := Root;
  70.     while true do begin
  71.     if Stricmp(Adr(rec^.Data), Adr(Current^.Data)) < 0 then begin
  72.         if Current^.Left = nil then begin
  73.         Current^.Left := rec;
  74.         return;
  75.         end else
  76.         Current := Current^.Left;
  77.     end else begin
  78.         if Current^.Right = nil then begin
  79.         Current^.Right := rec;
  80.         return;
  81.         end else
  82.         Current := Current^.Right;
  83.     end;
  84.     end;
  85. end;
  86.  
  87. Procedure AddWord(str : String);
  88. var
  89.     rec : WordPtr;
  90. begin
  91.     rec := WordPtr(AllocString(13 + strlen(str)));
  92.     strcpy(Adr(rec^.Data), str);
  93.     rec^.Left := nil;
  94.     rec^.Right := nil;
  95.     rec^.Count := 1;
  96.     EnterWord(rec);
  97. end;
  98.  
  99. Function FindWord(str : String) : WordPtr;
  100. var
  101.     Current : WordPtr;
  102.     Result  : Integer;
  103. begin
  104.     Current := Root;
  105.     while true do begin
  106.     if Current = nil then
  107.         FindWord := nil;
  108.     Result := stricmp(str, Adr(Current^.Data));
  109.     if Result < 0 then
  110.         Current := Current^.Left
  111.     else if Result > 0 then
  112.         Current := Current^.Right
  113.     else
  114.         FindWord := Current;
  115.     end;
  116. end;
  117.  
  118. Procedure Report(W : WordPtr);
  119. begin
  120.     if W <> nil then begin
  121.     Report(W^.Left);
  122.     Writeln(W^.Count, Chr(9), String(Adr(W^.Data)));
  123.     TotalWords := TotalWords + W^.Count;
  124.     Report(W^.Right);
  125.     end;
  126. end;
  127.  
  128. var
  129.     W : WordPtr;
  130.     FileName : String;
  131. begin
  132.     Root := nil;
  133.     CurrentWord := AllocString(128);
  134.     FileName := AllocString(80);
  135.     GetParam(1, FileName);
  136.     if FileName^ = Chr(0) then begin    { No parameter }
  137.     Writeln('Usage: Counter Filename');
  138.     Exit(10);
  139.     end;
  140.     if reopen(FileName, Infile) then begin
  141.     SkipWhiteSpace;
  142.     while not eof(Infile) do begin
  143.         ReadWord;
  144.         SkipWhiteSpace;
  145.         W := FindWord(CurrentWord);
  146.         if W = nil then
  147.         AddWord(CurrentWord)
  148.         else
  149.         W^.Count := Succ(W^.Count);
  150.     end;
  151.     TotalWords := 0;
  152.     Report(Root);
  153.     Writeln('Total Words: ', TotalWords);
  154.     Close(Infile);
  155.     end else
  156.     Writeln('Could not open the input file : ', FileName);
  157. end.
  158.